Μαρκοβιανές αλυσίδες

Αλυσίδες Markov Διακριτού Χρόνου

Πίνακας και διάγραμμα μεταβάσεων

Clear["Global`*"]
transitionMatrix = {{7/10, 0, 3/10, 0}, {1/2, 0, 1/2, 0}, {0, 2/5, 0, 3/5}, {0, 1/5, 0, 4/5}};
MatrixForm[transitionMatrix]
mp = DiscreteMarkovProcess[2, transitionMatrix];
Graph[mp]
Graph[mp, EdgeLabels -> {e_ :> ToString[MarkovProcessProperties[mp, "TransitionMatrix"][[## & @@ e]], InputForm]}]
\[\begin{pmatrix} \frac{7}{10} & 0 & \frac{3}{10} & 0 \\ \frac{1}{2} & 0 & \frac{1}{2} & 0 \\ 0 & \frac{2}{5} & 0 & \frac{3}{5} \\ 0 & \frac{1}{5} & 0 & \frac{4}{5} \end{pmatrix}\]
1 2 3 4
7/10 3/10 1/2 1/2 2/5 3/5 1/5 4/5 1 2 3 4

Ας δούμε και την πορεία στο χρόνο με ένα άλλο παράδειγμα.

Clear["Global`*"]
transitionMatrix1 = {{1/2, 1/2, 0, 0}, {1/2, 1/2, 0, 0}, {1/4, 1/4, 1/4, 1/4}, {0, 0, 0, 1}};
transitionMatrix = {{7/10, 0, 3/10, 0}, {1/2, 0, 1/2, 0}, {0, 2/5, 0, 3/5}, {0, 1/5, 0, 4/5}};
transitionMatrix // MatrixForm
\[\begin{pmatrix} \frac{7}{10} & 0 & \frac{3}{10} & 0 \\ \frac{1}{2} & 0 & \frac{1}{2} & 0 \\ 0 & \frac{2}{5} & 0 & \frac{3}{5} \\ 0 & \frac{1}{5} & 0 & \frac{4}{5} \end{pmatrix}\]
(*Οι mp και mp2 δεν έχουν διαφορά που να φαίνεται τώρα. Θα φανεί στην σχεδίαση της πορείας στο χρόνο*)
(*Με αρχική κατάσταση την 1*)
mp = DiscreteMarkovProcess[1, transitionMatrix];
(*Με αρχική κατανομή την p0*)
p0 = {1/8, 1/8, 1/4, 1/2}
mp2 = DiscreteMarkovProcess[p0, transitionMatrix];
Graph[mp]
\[{\frac{1}{8},\frac{1}{8},\frac{1}{4},\frac{1}{2}}\]
1 2 3 4

Πίνακας μετάβασης n βημάτων

PDF[mp[n], 2]
PDF[mp[n], katastasi] // PiecewiseExpand
\[\frac{3}{20}-(\frac{9}{44}) (5^{-n})+\frac{3 (2^{-2-2 n}) (5^{-2-n}) ({(3-\sqrt{89})}^{n}) (7+\sqrt{89}) (-53+9 (\sqrt{89}))}{11 (\sqrt{89})}-\frac{3 (2^{-2-2 n}) (5^{-2-n}) (-7+\sqrt{89}) ({(3+\sqrt{89})}^{n}) (53+9 (\sqrt{89}))}{11 (\sqrt{89})}\]
\[\begin{cases}(\frac{1}{979}) (2^{-2-2 n}) ({((\frac{1}{25}) (3+\sqrt{89}))}^{n}) (1068 (5^{n})+144 (5^{n}) (\sqrt{89})+801 (2^{2 n}) ({(\frac{5}{3+\sqrt{89}})}^{n})+979 (2^{2 n}) ({(\frac{25}{3+\sqrt{89}})}^{n})+1068 ({(\frac{5 (3-\sqrt{89})}{3+\sqrt{89}})}^{n})-144 (\sqrt{89}) ({(\frac{5 (3-\sqrt{89})}{3+\sqrt{89}})}^{n})) & katastasi=1 \\ (\frac{9}{979}) (2^{-2-2 n}) (5^{-1-n}) (445 (2^{2 n})+979 (2^{2 n}) (5^{n})-712 ({(3-\sqrt{89})}^{n})+96 (\sqrt{89}) ({(3-\sqrt{89})}^{n})-712 ({(3+\sqrt{89})}^{n})-96 (\sqrt{89}) ({(3+\sqrt{89})}^{n})) & katastasi=4 \\ (\frac{3}{979}) (2^{-2-2 n}) (5^{-1-n}) (-1335 (2^{2 n})+979 (2^{2 n}) (5^{n})+178 ({(3-\sqrt{89})}^{n})+86 (\sqrt{89}) ({(3-\sqrt{89})}^{n})+178 ({(3+\sqrt{89})}^{n})-86 (\sqrt{89}) ({(3+\sqrt{89})}^{n})) & katastasi=2 \\ (\frac{3}{979}) (2^{-2-2 n}) (5^{-1-n}) (-1335 (2^{2 n})+979 (2^{2 n}) (5^{n})+178 ({(3-\sqrt{89})}^{n})-134 (\sqrt{89}) ({(3-\sqrt{89})}^{n})+178 ({(3+\sqrt{89})}^{n})+134 (\sqrt{89}) ({(3+\sqrt{89})}^{n})) & katastasi=3 \\ 0 & True\end{cases}\]

Στάσιμη κατανομή

PDF[StationaryDistribution[mp], 2]
PDF[StationaryDistribution[mp], katastasi] // PiecewiseExpand
\[\frac{3}{20}\]
\[\begin{cases}\frac{3}{20} & {katastasi}^{2}>=0\mathbin{\&\&}(katastasi=2\mathbin{|}katastasi=3) \\ \frac{1}{4} & katastasi=1 \\ \frac{9}{20} & katastasi=4 \\ 0 & True\end{cases}\]

Πορεία στο χρόνο

myData = RandomFunction[mp, {0, 100}];
ListPlot[myData, Filling -> Axis]
myData2 = RandomFunction[mp2, {0, 100}];
ListPlot[myData2, Filling -> Axis]
0 25 50 75 100 0 1 2 3 4
0 25 50 75 100 0 1 2 3 4

Πιθανότητα πρώτης επαφής

proto = FirstPassageTimeDistribution[mp, 3];
PDF[proto, k]
\[\begin{cases}3 (7^{-1+k}) ({10}^{-k}) & k>0 \\ 0 & True\end{cases}\]

Σύνοψη συμπερασμάτων

myMatrix = {{1/3, 0, 2/3, 0, 0, 0}, {1/3, 1/3, 0, 1/3, 0, 0}, {1/2, 0,
     1/2, 0, 0, 0}, {0, 1/4, 0, 0, 1/2, 1/4}, {0, 0, 0, 0, 1, 0}, {0, 
    1, 0, 0, 0, 0}};
MatrixForm[myMatrix]
mp3 = DiscreteMarkovProcess[3, myMatrix];
Graph[mp3]
\[\begin{pmatrix} \frac{1}{3} & 0 & \frac{2}{3} & 0 & 0 & 0 \\ \frac{1}{3} & \frac{1}{3} & 0 & \frac{1}{3} & 0 & 0 \\ \frac{1}{2} & 0 & \frac{1}{2} & 0 & 0 & 0 \\ 0 & \frac{1}{4} & 0 & 0 & \frac{1}{2} & \frac{1}{4} \\ 0 & 0 & 0 & 0 & 1 & 0 \\ 0 & 1 & 0 & 0 & 0 & 0 \end{pmatrix}\]
1 2 3 4 5 6 
MarkovProcessProperties[mp3]
Raster Plot
Raster Plot
Raster Plot
Raster Plot
Raster Plot
Raster Plot
Raster Plot
Raster Plot

Αλυσίδες Markov Συνεχούς Χρόνου

Πίνακας και διάγραμμα μεταβάσεων

Clear["Global`*"]
mp = ContinuousMarkovProcess[{1, 0, 
    0}, ({{-2, 1, 1}, {1, -2, 1}, {1, 1, -2}})];
Graph[mp]
Graph[mp, EdgeLabels -> {e_ :> ToString[MarkovProcessProperties[mp, "TransitionMatrix"][[## & @@ e]], InputForm]}]
1 2 3
1 2 3

Κατανομή χρόνου παραμονής σε κατάσταση

PDF[mp[t], k] // PiecewiseExpand
\[\begin{cases}(\frac{1}{3}) (E^{-3 t}) (-1+E^{3 t}) & k=2\mathbin{|}k=3 \\ (\frac{1}{3}) (E^{-3 t}) (2+E^{3 t}) & k=1 \\ 0 & True\end{cases}\]

Πορεία στο χρόνο

myData = RandomFunction[mp, {0, 10}];
ListStepPlot[myData]
0 5 10 0 1 2 3